/* REXX _pairtrade.zrx by the reverend (build 98)                             */
/*-       built by rev-builder version 1.1 on 02 Jan 2003 at 11:11:15        -*/
/*- ------------------------------------------------------------------------ -*/
/*-                       Copyright (C) 2001 Ron Wilson                      -*/
/*-                                                                          -*/
/*- This script is free, and can be modified for your personal use, but you  -*/
/*- cannot copy or distribute this script or any derivative work based upon  -*/
/*- this script without the express permission of the author. Your use of    -*/
/*- this script is governed by the terms of the REV-LICENSE.                 -*/
/*-                                                                          -*/
/*- This program is provided to you WITHOUT ANY WARRANTY, even the implied   -*/
/*- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -*/
/*- REV-LICENSE for more details.                                            -*/
/*-                                                                          -*/
/*-                A copy of the REV-LICENSE is available at:                -*/
/*-       http://thereverend.coastgames.com/tradewars/rev-license.html       -*/
/*- ------------------------------------------------------------------------ -*/
/* description:  this script will trade down a port pair using four possible  */
/*               methods - no haggle, standard haggle, new haggle, and worst  */
/*               price. simply start with empty holds, or holds of the        */ 
/*               product being bought at the first port, and fire away.       */
/* rev. 0 - initial release                                                   */
/* rev. 1 - stops trading when port empty                                     */
/* rev. 2 - library update                                                    */
/* rev. 3 - minor bug fix                                                     */
/* rev. 4 - enhanced worst price haggle                                       */
/* rev. 5 - library update                                                    */
/* rev. 6 - updated error handling                                            */
/* rev. 7 - faster worst-price                                                */

call zoctimeout 30
call zocsynctime 500
globals=_setglobals(overpay)
call on halt name _halt

if \_pcheck("Command [") then call _error "please start at the command prompt."

mode=_chooselist("select a method:", "no haggle;standard haggle;new haggle;worst price", ";")
if mode="##CANCEL##" then call _quit "script cancelled by user"
select
 when mode="no haggle" then mode=1
 when mode="standard haggle" then mode=2
 when mode="new haggle" then mode=3
 when mode="worst price" then mode=4
end /*select*/

ans=zocrequest("what products?", "Org/Equ", "Ore/Equ", "Ore/Org")
select
 when ans="Org/Equ" then do
  prod.1="Organics"
  prod.2="Equipment"
  prod.3="Fuel Ore"
 end /*when*/
 when ans="Ore/Equ" then do
  prod.1="Fuel Ore"
  prod.2="Equipment"
  prod.3="Organics"
 end /*when*/
 when ans="Ore/Org" then do
  prod.1="Fuel Ore"
  prod.2="Organics"
  prod.3="Equipment"
 end /*when*/
 when ans="##CANCEL##" then call _quit "script cancelled by user"
end /*select*/

parse value _getinfo("hlds;ore;org;equ;col") with holds ";" ore ";" org ";" equ ";" colos
if zocwait("Command [")=640 then call _error "timeout"

if prod.3="Fuel Ore"  & ore>0 then call _quit "get rid of the fuel ore first"
if prod.3="Organics"  & org>0 then call _quit "get rid of the organics first"
if prod.3="Equipment" & equ>0 then call _quit "get rid of the equipment first"
if colos>0 then call _quit "get rid of colonists first"

call zocsend "d"

if zocwait("Warps to Sector(s) :")=640 then call _error "timeout"
if zocwait("^M")=640 then call _error "timeout"
wlist=_lastline()
if zocwait("Command [")=640 then call _error "timeout"

sect.2=_chooselist("which sector to trade with?", wlist, "-")
if sect.2="##CANCEL##" then call _quit "script cancelled by user."
sect.2=_stripint(sect.2)

call zocrespond prod.3||" do you want to sell [", "0^M"
call zocrespond prod.3||" do you want to buy [", "0^M"

more=0
done=0
do while \done
 done=_trade(mode)
end /*while*/

call zocsend "m"||sect.2||"^M"
pans=zocwaitmux("Command [", "Class ")
select
 when pans=0 then call _quit "no port in this sector"
 when pans=1 then do
  if zocwait("^M")=640 then call _error "timeout"
  if zocwait("Command [")=640 then call _error "timeout"
  if left(_lastline(),1)=0 then call _quit "cannot trade with class 0 port"
 end /*when*/
 when pans=640 then call _error "timeout"
end /*select*/

do while more<2
 if more=1 then more=2
 if _trade(mode) & more<2 then do
  call zocsend "<"
  if zocwait("Command [")=640 then call _error "timeout"
 end /*if*/
end /*do*/

call zocrespond prod.3||" do you want to sell ["
call zocrespond prod.3||" do you want to buy ["

call _quit "trading complete."

exit

_trade:
 m1=arg(1)
 if m1=\_in("0123456789",left(m1,1)) then m1=1
 m1=trunc(m1*10)

 call zocsend "pt"

/*
-=-=-        Docking Log        -=-=-
A Ferrengi just left.

 Items     Status  Trading % of max OnBoard
 -----     ------  ------- -------- -------
Fuel Ore   Buying    2890    100%       0
Organics   Selling    577     48%       0
Equipment  Buying    1463     82%      65
*/

 if zocwait(" -------^M")=640 then call _error "timeout"
 if zocwait("^M")=640 then call _error "timeout"
 pore=_lastline()
 if pore=640 then call _error "timeout"
 if zocwait("^M")=640 then call _error "timeout"
 porg=_lastline()
 if porg=640 then call _error "timeout"
 if zocwait("^M")=640 then call _error "timeout"
 pequ=_lastline()
 if pequ=640 then call _error "timeout"

 pore=_stripint(substr(pore,17,9))
 porg=_stripint(substr(porg,17,9))
 pequ=_stripint(substr(pequ,17,9))

 if prod.1="Fuel Ore"  & pore<holds*2 then more=1
 if prod.1="Organics"  & porg<holds*2 then more=1
 if prod.1="Equipment" & pequ<holds*2 then more=1

 if prod.2="Fuel Ore"  & pore<holds*2 then more=1
 if prod.2="Organics"  & porg<holds*2 then more=1
 if prod.2="Equipment" & pequ<holds*2 then more=1

 tdone=0
 do while \tdone

  tans=zocwaitmux(prod.1||" do you want to sell [", ,
                  prod.1||" do you want to buy [", ,
                  prod.2||" do you want to sell [", ,
                  prod.2||" do you want to buy [", ,
                  "Command [", ,
                  "You don't have anything")
  if tans<4 then do
   if zocwait("]")=640 then call _error "timeout"
   amount=_stripint(_lastline())
   call zocsend amount||"^M"
   if amount=0 then do
    if zocwait("Command [")=640 then call _error "timeout"
    call _quit "nothing to trade"
   end /*if*/
   if zocwait("Your offer [")=640 then call _error "timeout"
   if zocwait("]")=640 then call _error "timeout"
   offer=_stripint(_lastline())
   trsuccess=0
  end /*if*/

  select
   when m1+tans=10 then trsuccess=_sellnohaggle(offer)
   when m1+tans=11 then trsuccess=_buynohaggle(offer)
   when m1+tans=12 then trsuccess=_sellnohaggle(offer)
   when m1+tans=13 then trsuccess=_buynohaggle(offer)

   when m1+tans=20 then trsuccess=_sellhaggle1(offer)
   when m1+tans=21 then trsuccess=_buyhaggle1(offer)
   when m1+tans=22 then trsuccess=_sellhaggle1(offer)
   when m1+tans=23 then trsuccess=_buyhaggle1(offer)

   when m1+tans=30 then trsuccess=_sellhaggle2(offer)
   when m1+tans=31 then trsuccess=_buyhaggle2(offer)
   when m1+tans=32 then trsuccess=_sellhaggle2(offer)
   when m1+tans=33 then trsuccess=_buyhaggle2(offer)

   when m1+tans=40 then trsuccess=_sellhaggle2(offer)
   when m1+tans=41 then trsuccess=_buyhaggle3(offer)
   when m1+tans=42 then trsuccess=_sellhaggle2(offer)
   when m1+tans=43 then trsuccess=_buyhaggle3(offer)

   when tans=4 then tdone=1
   when tans=5 then call _quit "nothing to trade"
   when tans=640 then call _error "timeout"
   otherwise call _error "unknown case - mode="||m1||" tans="||tans
  end /*select*/

 end /*do*/

return trsuccess

/***                 THE REVEREND'S TW LIBRARY FOR ZOC/REXX                 ***/

/** _setglobals v.3 **/
    _setglobals: procedure expose _verbose _monthdays _monthnames _baseday. (globals)
    
     _verbose=0
     _monthdays="31;28;31;30;31;30;31;31;30;31;30;31"
     _monthnames="jan;feb;mar;apr;may;jun;jul;aug;sep;oct;nov;dec"
     _baseday.2000=730118
     _baseday.2001=_baseday.2000+365+1
     _baseday.2002=_baseday.2001+365
     _baseday.2003=_baseday.2002+365
     _baseday.2004=_baseday.2003+365
     _baseday.2005=_baseday.2004+365+1
     _baseday.2006=_baseday.2005+365
     _baseday.2007=_baseday.2006+365
     _baseday.2008=_baseday.2007+365
    
     rslt="_g. _s. _p. _d. _v. _f. _m. _q. "
     rslt=rslt||"_ef. _es. _et. _ep. "
     rslt=rslt||"_path. _dist. _dtomsl. _dfrmsl. "
     rslt=rslt||"_bg. _nwi. _od. _sv. _pv. _bust. _vs. _vn. "
     rslt=rslt||"_olist1. _olist2. _clvlist1. _clvlist2. "
     rslt=rslt||"_verbose _monthdays _monthnames _baseday. "
     rslt=rslt||"globals reconnect scriptname lra "
     if arg(1,"E") then rslt=rslt||arg(1)
    
     rslt=_space(rslt)
    return rslt

/** _halt v.3 **/
    _halt: procedure expose (globals)
     call off halt
     call zocwriteln "^[[1;33m< user abort >^[[0m "
     exit
    return

/** _pcheck v.4 **/
    _pcheck: procedure expose (globals)
     pc1=arg(1)
     pc2=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     rslt=0
     do i=1 to _dwords(pc1,";")
      if _instr(_dword(pc1,i,";"),pc2,"cs") then rslt=1
     end /*do*/
    return rslt

/** _error v.7 **/
    _error: procedure expose (globals)
     call off halt
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln
     call zocwrite _ansi("bt;frd")||"< script error"
     if arg(1,"E") then call zocwrite ": "||arg(1)
     call zocwriteln " >"
     call zocwriteln _ansi("bt;fye")||"< if this is a serious problem, email me at: the.reverend@coastgames.com > "
     call zocwriteln "< ZOC VERSION '"||zocgetinfo("VERSION")||"', OS '"||zocgetinfo("OSYS")||"', LOCATION '"||zocgetinfo("CONNECTEDTO")||"' >"
     if arg(2,"E") then call zocwriteln _ansi("bt;fgr")||"< "||arg(2)||" >"
     call zocwrite _ansi()
     call _beep "error.wav"
     if reconnect=1 & arg(1)="timeout" then do
      /* call zocdisconnect */
      call zocwriteln _ansi("bt;fwh")||"< ATTEMPTING TO RECONNECT >"
      call zocdostring "^RUN=_connect.zrx sn="||scriptname
     end /*if*/
    exit

/** _chooselist v.6 **/
    _chooselist: procedure expose (globals)
     prompt=arg(1)
     list=arg(2)
     if list="" then call _error "no list"
     delim=arg(3)
     if delim="" then delim=" "
     if length(delim)>1 then call _error "long delimiter"
    
     ch.=""
     i=_dwords(list,delim)
     do j=1 to i
      ch.j=_dword(list,j,delim)
     end /*do*/
    
     if i<7 then max=1
     if i<5 then max=0
     if i>=7 then max=(i-5)%2+1
    
     done=0
     loc=0
     do while \done
      if loc<0 then loc=0
      if loc>max then loc=max
    
      select
       when loc=0 then do
        if max=0 then rslt=zocrequest(prompt, ch.1, ch.2, ch.3, ch.4)
        else rslt=zocrequest(prompt, ch.1, ch.2, ch.3, "next")
       end /*when*/
       when loc=max then do
        p1=(loc-1)*2+4
        p2=p1+1
        p3=p1+2
        rslt=zocrequest(prompt, "back", ch.p1, ch.p2, ch.p3)
       end /*when*/
       otherwise do
        p1=(loc-1)*2+4
        p2=p1+1
        rslt=zocrequest(prompt, "back", ch.p1, ch.p2, "next")
       end /*otherwise*/
      end /*select*/
    
      select
       when rslt="next" then loc=loc+1
       when rslt="back" then loc=loc-1
       when rslt="##CANCEL##" then done=1
       when rslt="" then nop
       otherwise done=1
      end /*select*/
    
     end /*do*/
    
     if lower(arg(4))="c" & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    
    return rslt

/** _quit v.7 **/
    _quit: procedure expose (globals)
     lcpy=1
     arg1=""
     do i=1 to 2 /* manage arguments */
      select
       when arg(i,"E") & lower(arg(i))="nocopy" then lcpy=0
       when arg(i,"E") & arg1="" then arg1=arg(i)
       otherwise nop
      end /*select*/
     end /*do*/
     line=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     select /* define message */
      when  lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m^M^J"||line
      when \lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m "
      when  lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m^M^J"||line
      when \lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m "
      otherwise nop
     end /*select*/
     call zocwrite msg
     select /* choose a beep */
      when lower(arg1)="script cancelled by user." then call _beep "cancel.wav"
      otherwise call _beep "quit.wav"
     end /*select*/
     exit
    return 1

/** _getinfo v.5 **/
    _getinfo: procedure expose (globals)
     args=lower(arg(1))
     bufflen=3*1024
     call zocreceivebuf bufflen
     call zocsend "/"
     if zocwait("Sect ")=640 then call _error "timeout"
     if zocwait("Ship ")=640 then call _error "timeout"
     if zocwait("^M")=640 then call _error "timeout"
     buff=translate(zocreceivebuf(0),"  ",d2c(10)||d2c(0))
     if length(buff)>=bufflen then call zocwrite "<buffer overflow>"
     i=pos("Sect ",buff)
     j=pos("Ship",buff,i)
     j=pos(d2c(13),buff,j)
     buff=substr(buff,i,j-i)
     buff=_space(translate(buff, "  ;;", d2c(0)||d2c(10)||d2c(13)||d2c(179)),1)
     buff=translate(_space(translate(buff,", "," ,"),0),", "," ,")
    
     vr.=""
     vl.=""
     c=0
     do j=1 to _dwords(buff,";")
      c=c+1
      vr.c=strip(_dword(buff,j,";"))
      vl.c=word(vr.c,2)
      vr.c=lower(word(vr.c,1))
      if vr.c="ship" then do
       c=c+1
       vr.c=strip(_dword(buff,j,";"))
       vl.c=word(vr.c,3)
       vr.c="shiptype"
      end /*if*/
     end /*do*/
    
     rslt=""
     do i=1 to _dwords(args,";")
      found=0
      do j=1 to c
       if vr.j=_dword(args,i,";") then do
        rslt=rslt||";"||vl.j
        found=1
       end /*if*/
      end /*do*/
      if \found then rslt=rslt||";"||"##NA##"
     end /*do*/
     if rslt\="" then rslt=substr(rslt,2)
    
    return rslt

/** _lastline v.3 **/
    _lastline: procedure expose (globals)
     rslt=zoclastline()
     select
      when lower(arg(1))="raw" then nop
      when pos(d2c(7),rslt)>0  then rslt=translate(zocstring("REMOVE", rslt, d2c(7)),"  ",d2c(0)||d2c(10))
      otherwise                     rslt=translate(rslt,"  ",d2c(0)||d2c(10))
     end /*select*/
    return rslt

/** _stripint v.4 **/
    _stripint: procedure expose (globals)
     mask=_space(translate(arg(1)," ","-0123456789"," "),0)
     rslt=_space(translate(arg(1)," ",mask," "),0)
     if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0)
     else rslt=_space(translate(rslt," ","-"),0)
     if \datatype(rslt,"W") then rslt=""
    return rslt

/** _in v.3 **/
    _in: procedure expose (globals)
     if arg(1,"E") & arg(2,"E") & length(arg(1))>0 & verify(arg(2),arg(1),"N")=0 then rslt=1
     else rslt=0
    return rslt

/** _sellnohaggle v.2 **/
    _sellnohaggle: procedure expose (globals)
     offer=arg(1)
     call zocsend "^M"
     if zocwait("You have")=640 then call _error "timeout"
    return 1

/** _buynohaggle v.1 **/
    _buynohaggle: procedure expose (globals)
     offer=arg(1)
     call zocsend "^M"
     if zocwait("You have")=640 then call _error "timeout"
    return 1

/** _sellhaggle1 v.2 **/
    _sellhaggle1: procedure expose (globals)
     portoffer=arg(1)
     do c=1 to 5
      offer.c=trunc(portoffer/((100-c)/100),0)
     end /*do*/
    
     success=1
    
     call zocsend offer.5||"^M"
     iter=4
    
     done=0
     do while \done
    
      ans=zocwaitmux("We'll buy them for", ,
                       "Our final offer", ,
                       "We're not interested.", ,
                       "You have")
      select
    
       when ans=0 then do
        if zocwait("Your offer [")=640 then call _error "timeout"
        call zocsend offer.iter||"^M"
        iter=iter-1
       end /*when*/
    
       when ans=1 then do
        if zocwait("Your offer [")=640 then call _error "timeout"
        call zocsend offer.iter||"^M"
        iter=iter-1
       end /*when*/
    
       when ans=2 then do
        done=1
        success=0
       end /*when*/
    
       when ans=3 then done=1
    
       when ans=640 then call _error "timeout"
    
       otherwise nop
    
      end /*select*/
    
     end /*while*/
    
    return success

/** _buyhaggle1 v.1 **/
    _buyhaggle1: procedure expose (globals)
     portoffer=arg(1)
     do c=1 to 5
      offer.c=trunc(portoffer*((100-c)/100),0)
     end /*do*/
    
     success=1
    
     call zocsend offer.5||"^M"
     iter=4
    
     done=0
     do while \done
    
      ans=zocwaitmux("We'll sell them for", ,
                       "Our final offer", ,
                       "We're not interested.", ,
                       "You have")
      select
    
       when ans=0 then do
        if zocwait("Your offer [")=640 then call _error "timeout"
        call zocsend offer.iter||"^M"
        iter=iter-1
       end /*when*/
    
       when ans=1 then do
        if zocwait("Your offer [")=640 then call _error "timeout"
        call zocsend offer.iter||"^M"
        iter=iter-1
       end /*when*/
    
       when ans=2 then do
        done=1
        success=0
       end /*when*/
    
       when ans=3 then done=1
    
       when ans=640 then call _error "timeout"
    
       otherwise nop
    
      end /*select*/
    
     end /*while*/
    
    return success

/** _sellhaggle2 v.2 **/
    _sellhaggle2: procedure expose (globals)
     portoffer=arg(1)
     offer=trunc(portoffer*1.06)
    
     success=1
     iter=1
    
     call zocsend offer||"^M"
    
     done=0
     do while \done
    
      ans=zocwaitmux("We'll buy them for", ,
                       "Our final offer", ,
                       "We're not interested.", ,
                       "You have")
      select
    
       when ans=0 then do
        if zocwait("Your offer [")=640 then call _error "timeout"
        if zocwait("]")=640 then call _error "timeout"
        newportoffer=_stripint(_lastline())
        iter=iter+1
        newoffer=trunc(offer/max(1.003,(newportoffer/portoffer)))
        if newoffer>=offer then newoffer=offer-1
        offer=newoffer
        portoffer=newportoffer
        call zocsend offer||"^M"
       end /*when*/
    
       when ans=1 then do
        if zocwait("Your offer [")=640 then call _error "timeout"
        if zocwait("]")=640 then call _error "timeout"
        finalportoffer=_stripint(_lastline())
        iter=iter+1
        factor=0.5
        if iter<3 then factor=0.6
        offer=trunc(offer*(1-factor) + finalportoffer*factor)
        call zocsend offer||"^M"
       end /*when*/
    
       when ans=2 then do
        done=1
        success=0
       end /*when*/
    
       when ans=3 then do
        done=1
       end /*when*/
    
       when ans=640 then call _error "timeout"
    
       otherwise nop
    
      end /*select*/
    
     end /*while*/
    
    return success

/** _buyhaggle2 v.2 **/
    _buyhaggle2: procedure expose (globals)
     portoffer=arg(1)
     offer=trunc(portoffer/1.06)
    
     success=1
    
     call zocsend offer||"^M"
     iter=1
    
     done=0
     do while \done
    
      ans=zocwaitmux("We'll sell them for",,
                     "Our final offer",,
                     "We're not interested.",,
                     "You have")
      select
    
       when ans=0 then do
        if zocwait("Your offer [")=640 then call _error "timeout"
        newportoffer=_stripint(_grabit("]"))
        iter=iter+1
        newoffer=trunc(offer*max(1.003,(newportoffer/portoffer)))
        if newoffer<=offer then newoffer=offer+1
        offer=newoffer
        portoffer=newportoffer
        call zocsend offer||"^M"
       end /*when*/
    
       when ans=1 then do
        if zocwait("Your offer [")=640 then call _error "timeout"
        finalportoffer=_stripint(_grabit("]"))
        iter=iter+1
        factor=0.5
        if iter<3 then factor=0.6
        offer=trunc(offer*(1-factor) + finalportoffer*factor)
        call zocsend offer||"^M"
       end /*when*/
    
       when ans=2 then do
        done=1
        success=0
       end /*when*/
    
       when ans=3 then done=1
    
       when ans=640 then call _error "timeout"
    
       otherwise nop
    
      end /*select*/
    
     end /*while*/
    
    return success

/** _buyhaggle3 v.3 **/
    _buyhaggle3: procedure expose (globals)
     portoffer=arg(1)
     op=arg(2)
     if op="" then op=43
     offer=trunc(portoffer*((100+op)/100),0)
    
     success=1
    
     call zocwrite "^[[1;32m< overpaying by "||op||"% >^[[0;35m "
     call zocsend offer||"^M"
     op=op-1
     opcount=1
    
     done=0
     do while \done
    
      ans=zocwaitmux("We'll sell them for", ,
                       "my time", ,
                       "a real offer", ,
                       "WHAT?!@!?", ,
                       "short with you", ,
                       "choke me up!", ,
                       "Our final offer", ,
                       "We're not interested.", ,
                       "You have")
      select
    
       when ans<=5 then do
        if zocwait("Your offer [")=640 then call _error "timeout"
        offer=trunc(portoffer*((100+op)/100),0)
        call zocwrite "^[[1;32m< overpaying by "||op||"% >^[[0;35m "
        call zocsend offer||"^M"
        opcount=opcount+1
        op=op-1
       end /*when*/
    
       when ans=6 then do
        if zocwait("Your offer [")=640 then call _error "timeout"
        offer=trunc(portoffer*((100+op)/100),0)
        call zocwrite "^[[1;32m< overpaying by "||op||"% >^[[0;35m "
        call zocsend offer||"^M"
        opcount=opcount+1
        op=op-1
       end /*when*/
    
       when ans=7 then do
        done=1
        success=0
       end /*when*/
    
       when ans=8 then done=1
    
       when ans=640 then call _error "timeout"
    
       otherwise nop
    
      end /*select*/
    
     end /*while*/
    
     if datatype(overpay,"W") then do
      select
       when opcount>1 then overpay=overpay-opcount+1
       otherwise nop
      end /*select*/
     end /*if*/
    
    return success

/** _space v.1 **/
    _space: procedure expose (globals)
     str=strip(arg(1))
     if arg(2,"E") then n=arg(2); else n=1
     if arg(3,"E") then pad=arg(3); else pad=" "
     rslt=word(str,1)
     do i=2 to words(str)
      rslt=rslt||copies(pad,n)||word(str,i)
     end /*do*/
    return rslt

/** _dwords v.2 **/
    _dwords: procedure expose (globals)
     rslt=words(translate(arg(1),arg(2)||" "," "||arg(2)))
    return rslt

/** _instr v.3 **/
    _instr: procedure expose (globals)
     fnd=arg(1)
     str=arg(2)
     if lower(arg(3))\="cs" then do
      fnd=lower(fnd)
      str=lower(str)
     end /*if*/
     if arg(1,"E") & arg(2,"E") & pos(fnd,str)>0 then rslt=1
     else rslt=0
    return rslt

/** _dword v.2 **/
    _dword: procedure expose (globals)
     rslt=translate(word(translate(arg(1),arg(3)||" "," "||arg(3)),arg(2))," "||arg(3),arg(3)||" ")
    return rslt

/** _ansi v.3 **/
    _ansi: procedure expose (globals)
     rslt="0"
     do i=1 to _dwords(arg(1),";")
      w=_dword(arg(1),i,";")
      select
       when w="dl"  then rslt=rslt||";"||0  /* dull               */
       when w="bt"  then rslt=rslt||";"||1  /* bright             */
       when w="ul"  then rslt=rslt||";"||4  /* underlined         */
       when w="blk" then rslt=rslt||";"||5  /* blinking           */
       when w="fbk" then rslt=rslt||";"||30 /* black foreground   */
       when w="frd" then rslt=rslt||";"||31 /* red foreground     */
       when w="fgr" then rslt=rslt||";"||32 /* green foreground   */
       when w="fye" then rslt=rslt||";"||33 /* yellow foreground  */
       when w="fbl" then rslt=rslt||";"||34 /* blue foreground    */
       when w="fmg" then rslt=rslt||";"||35 /* magenta foreground */
       when w="fcy" then rslt=rslt||";"||36 /* cyan foreground    */
       when w="fwh" then rslt=rslt||";"||37 /* white foreground   */
       when w="bbk" then rslt=rslt||";"||40 /* black background   */
       when w="brd" then rslt=rslt||";"||41 /* red background     */
       when w="bgr" then rslt=rslt||";"||42 /* green background   */
       when w="bye" then rslt=rslt||";"||43 /* yellow background  */
       when w="bbl" then rslt=rslt||";"||44 /* blue background    */
       when w="bmg" then rslt=rslt||";"||45 /* magenta background */
       when w="bcy" then rslt=rslt||";"||46 /* cyan background    */
       when w="bwh" then rslt=rslt||";"||47 /* white background   */
       otherwise nop
      end /*select*/
     end /*do*/
     rslt="^[["||rslt||"m"
    return rslt

/** _beep v.2 **/
    _beep: procedure expose (globals)
     select
      when arg(1,"O") then call zocwrite d2c(7)
      when _fileexists(arg(1)) then call zocplaysound arg(1)
      otherwise call zocwrite d2c(7)
     end /*select*/
    return

/** _grabit v.2 **/
    _grabit: procedure expose (globals)
     if zocwait(arg(1))=640 then call _error "timeout"
     rslt=_lastline()
     if lower(arg(2))="s" then rslt=reverse(substr(reverse(rslt),length(arg(1))))
    return rslt

/** _fileexists v.3 **/
    _fileexists: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileexists"
     if stream(arg(1), "C", "QUERY EXISTS")="" then rslt=0; else rslt=1
    return rslt